home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / cwaudit.zip / CWAUDDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-21  |  3KB  |  136 lines
  1. {
  2.  Author:    Craig Ward
  3.  Copyright: none - public domain
  4.  
  5.  Date:      21/5/96
  6.  
  7.  Version:   1.0
  8.  
  9.  Overview:  system dialog.
  10. *******************************************************************************}
  11. unit Cwauddlg;
  12.  
  13. interface
  14.  
  15. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  16.   StdCtrls, Grids, Outline, Cwbutton, ExtCtrls, sysutils, dialogs, messages;
  17.  
  18.  
  19. type
  20.   TAuditDlg = class(TForm)
  21.     Bevel1: TBevel;
  22.     cwButton1: TcwButton;
  23.     cwButton2: TcwButton;
  24.     outAudit: TOutline;
  25.     SpeedButton1: TSpeedButton;
  26.     SpeedButton2: TSpeedButton;
  27.     Label1: TLabel;
  28.     procedure cwButton1Click(Sender: TObject);
  29.     procedure cwButton2Click(Sender: TObject);
  30.     procedure SpeedButton2Click(Sender: TObject);
  31.     procedure SpeedButton1Click(Sender: TObject);
  32.   private
  33.     { Private declarations }
  34.     procedure SetTextFile(const value: string);
  35.     function mFileSize(const sFile: string): boolean;
  36.   public
  37.     { Public declarations }
  38.     FTextFile: string;
  39.     property TextFile: string read FTextFile write SetTextFile;
  40.   end;
  41.  
  42. var
  43.   AuditDlg: TAuditDlg;
  44.  
  45. implementation
  46.  
  47. {$R *.DFM}
  48.  
  49. uses
  50.  cw_apps;
  51.  
  52. {***buttons********************************************************************}
  53.  
  54. {close}
  55. procedure TAuditDlg.cwButton1Click(Sender: TObject);
  56. begin
  57.  modalResult := mrOK;
  58. end;
  59.  
  60. {help}
  61. procedure TAuditDlg.cwButton2Click(Sender: TObject);
  62. begin
  63.  Application.HelpCommand(HELP_CONTEXT,helpContext);
  64. end;
  65.  
  66. {print}
  67. procedure TAuditDlg.SpeedButton2Click(Sender: TObject);
  68. var
  69.  lpszFile: pChar;
  70. begin
  71.  lpszFile := StrAlloc(fsMaxFullFileName);
  72.  try
  73.   {use the /p switch, which forces notepad to print}
  74.   StrPCopy(lpszFile,'notepad.exe /p '+FTextFile);
  75.   WinExec(lpszFile,SW_HIDE);
  76.  finally
  77.   StrDispose(lpszFile);
  78.  end;
  79. end;
  80.  
  81. {purge}
  82. procedure TAuditDlg.SpeedButton1Click(Sender: TObject);
  83. var
  84.  tF: file;
  85. begin
  86.  if FTextFile <> '' then
  87.   if FileExists(FTextFile) then
  88.    begin
  89.     AssignFile(tF,FTextFile);
  90.     Rewrite( tF );   {forces new file to be created}
  91.     CloseFile(tF);
  92.     {re-load}
  93.     outAudit.lines.clear;
  94.     if mFileSize(FTextFile) then
  95.      outAudit.LoadFromFile(FTextFile);
  96.    end;
  97. end;
  98.  
  99.  
  100. {***VCL preferences************************************************************}
  101.  
  102. {set text file}
  103. procedure TAuditDlg.SetTextFile(const value: string);
  104. begin
  105.  if value <> FTextFile
  106.   then
  107.    begin
  108.     FTextFile := value;
  109.     if mFileSize(FTextFile) then
  110.      outAudit.LoadFromFile(FTextFile);
  111.    end;
  112. end;
  113.  
  114. {***I\O************************************************************************}
  115.  
  116. {check file size - if greater than 64k then return false}
  117. function TAuditDlg.mFileSize(const sFile: string): boolean;
  118. var
  119.  tc: file of char;
  120. begin
  121.  result := false;
  122.  if fileExists(sFile) then
  123.   begin
  124.    AssignFile(tc,sFile);
  125.    reset(tc);
  126.    if FileSize(tc) > 65535 then
  127.     result := false
  128.    else
  129.     result := true;
  130.    CloseFile(tc);
  131.   end;
  132. end;
  133.  
  134. {}
  135. end.
  136.